home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Zoom 2
/
Zoom - Release 2 (1996)(Active Software)[!].iso
/
misc
/
scion409
/
scionarexx.lha
/
PrintDescendant.rexx
< prev
next >
Wrap
OS/2 REXX Batch file
|
1995-09-21
|
19KB
|
692 lines
/****************************************************************************
* *
* $VER: PrintDescendant 2.00 (2 Feb 1995)
* *
* Written by Freddy Ariës *
* *
* Output options: *
* 1. Descendant Chart - all descendants [Dutch: parenteel] *
* 2. Descendant Chart - male descendants (mention daughters, no children) *
* [Dutch: genealogie - nageslacht van zonen, maar vermelding dochters] *
* 3. Descendant Chart - male descendants (leave out daughters) *
* [Dutch: stamboom - nageslacht van zonen, geen vermelding dochters] *
* *
* This script uses (by default) the rexxreqtools.library (which requires *
* a version of reqtools larger than 2.0 and rexxsyslib.library) *
* If you do not have these, you need to supply the NOREQ argument (for *
* Shell output), or the QUIET argument (for no output at all). *
* *
* As of v2 of this script, and Scion V4, the current person on Scion's *
* Personal Window will be used to determine where the search starts. *
* Scion 3.13 can still be used, though, in which case the user will be *
* asked at which IRN he wants to start. *
* *
* TO DO (mostly low priority, unless someone really wants this): *
* - find a good way to handle the people with sex '?' *
* - count the number of lines output and give a linefeed after a certain *
* number (ie. skip page breaks) *
* - add a menu option for the maximum number of generations to print *
* - allow user to specify if he wants burial data printed, occupation, *
* comments, references fields, .... *
* - If the person has multiple marriages, output a list to the *
* screen and let the user select one (1..x), or all (0). *
* - Suggestions, comments, bugreports, donations, etc. are appreciated. *
* *
****************************************************************************/
options results
arg prtin outname noirn mgen outval
versionstr = "2.00"
usereq = 1; /* change this to 0 if you don't want to use reqtools */
outp = 1; useirn = 1; prtdev = stdout; prtopt = 0
plwidth = 78; /* linewidth of the printer */
NL = '0A'x
PSCR = 'SCIONGEN'; /* public screen to open the requesters on */
signal on IOERR
do while prtin = '?'
Tell("NUMOPT/A/N,OUTFILE/A,NOIRN/S,MAXGEN/N,NOREQ/S,QUIET/S: ")
pull prtin outname noirn mgen outval
end
ParseArguments()
if usereq & ~show('l','rexxreqtools.library') then do
if exists('libs:rexxreqtools.library') then
call addlib('rexxreqtools.library',0,-30,0)
else do
usereq = 0; outp = 1
Tell("Unable to open rexxreqtools.library - using text output")
end
end
/* These few lines were stolen from Peter Billings - thanks Peter ;-) */
if ~show('P','SCIONGEN') then do
TermError('I am sorry to say that the SCION Genealogist' || NL ||,
'database is not available. Please start the' || NL ||,
'SCION program BEFORE using this script!')
end
myport = "SCIONGEN"
address value myport
GETDBNAME
dbname = upper(RESULT)
fill = 7; /* number of spaces at the beginning of lines */
malesex = 'M'; /* as of V4, sexes are always 'M', 'F' or '?' */
femalesex = 'F'
GETPROGVERSION
progvers = RESULT
if progvers >= 4 then do
GETCURRENTIRN
irn = RESULT
end
if outp & ~usereq then do
Tell("*** PrintDescendant version "||versionstr||" ***")
Tell("*** by Freddy Ariës ***")
Tell("Current database: "||dbname||NL)
end
if prtopt = 0 then do
if usereq then do
prtopt = rtezrequest('Current Scion database: '||dbname||NL||,
NL||'Please make your choice: '||,
NL||' 1. Descendant Chart - all descendants'||,
NL||' 2. Descendant Chart - male descendants'||,
NL||' (mention daughters, without children)'||,
NL||' 3. Descendant Chart - male descendants'||,
NL||' (leave out daughters)'||,
'',' _1 | _2 | _3 |E_xit','PrintDescendant v'||versionstr||' by Freddy Ariës','rt_pubscrname = '||PSCR)
if prtopt = 0 then
EXIT
if progvers < 4 then do
irn = rtgetlong(,'Enter the IRN of the person whose'||,
NL||'descendants you want to print: '||,
NL,'Input Request:','_Continue','rt_pubscrname = '||PSCR)
if irn = '' then
EXIT
irn = abs(irn)
end
useirn = rtezrequest('Do you want to output the IRNs'||,
NL||'(the record numbers) as well?'||,
'',' _Yes| _No ','Input Request:','rt_pubscrname = '||PSCR)
end
else do
/* No use in asking for input if we're not allowed to output anything */
Tell("1. Descendant Chart - all descendants")
Tell("2. Descendant Chart - male descendants (mention daughters, without children)")
Tell("3. Descendant Chart - male descendants (leave out daughters)")
TellNN("Your choice: ")
pull prtopt
prtopt = CheckAnswer(prtopt)
if progvers < 4 then do
TellNN("Enter the IRN of the person whose descendants you want to print: ")
pull irn
end
TellNN("Do you want to output the IRNs (numbers) as well (y/n)? ")
pull instr
Tell("")
if left(instr, 1) = "Y" then useirn = 1
else useirn = 0
end
end
if progvers < 4 then do
irn = CheckIRN(irn)
end
EXISTPERSON irn
if RESULT ~= 'YES' then
do
if progvers >= 4 then
TermError("Unable to locate current person in the current database.")
else
TermError("No person with IRN "||irn||" in the current database.")
end
if prtopt > 1 then do
GETSEX irn
parsex = RESULT
if prtopt = 3 & parsex = femalesex then
TermError("Person isn't male - nothing to print.")
end
if outp then do
/* No use trying to get input if we're not allowed to ask anything */
pname = GetNameStr(irn, 0)
if prtopt = 1 | parsex = malesex then do
if usereq then do
valcont = rtezrequest('The selected person is: '||NL||pname||'.'||,
NL||'Continue?','_Continue| _Abort','PrintDescendant Request:','rt_pubscrname = '||PSCR)
if valcont = 0 then
EXIT
end
else do
TellNN("Current person is "||pname||". Continue? (y/n) ")
pull valcont
if left(valcont, 1) ~= 'Y' then
TermError("Ok.")
end
end
else do
/* with prtopt = 2, we would only print the (generation I) female and
* her husbands, but no children!
*/
if usereq then do
valcont = rtezrequest("WARNING!!! Person "||NL||pname||,
NL||"is not male! Continue anyway?",'_Continue| _Abort','PrintDescendant Request:','rt_pubscrname = '||PSCR)
if valcont = 0 then
EXIT
end
else do
Tell("WARNING! Person "||pname||" isn't male!")
TellNN("Continue anyway? (y/n) ")
pull valcont
if left(valcont, 1) ~= 'Y' then
TermError("Ok.")
end
end
end
/* TO DO: (at this location:)
* If the person has multiple marriages, output the spouse name, IRN
* and FGRN to screen, and let the user select one (1..x), or all (0)
*/
if outp & outname = "" then do
if usereq then do
odev = rtezrequest('Current Scion database: '||dbname||,
NL||'Where should the output be sent to?'||,
NL,' _File |_Printer|_Screen|_Nowhere','PrintDescendant v'||versionstr||' by Freddy Ariës','rt_pubscrname = '||PSCR)
select
when odev = 1 then do
/* We need a file requester for further data */
dblen = length(dbname)
if dblen>6 & right(dbname, 6)=".SCION" then
dbname=left(dbname, dblen - 6)
outname = rtfilerequest(,dbname||'.DSC','Output filename',,'rtfi_buffer = true rt_pubscrname = '||PSCR||' rtfi_initialpath = RAM:',)
if outname = '' then
outname = dbname||'.DSC'
end
when odev = 2 then
outname = 'PRT:'
when odev = 3 then
outname = 'STDOUT'
otherwise
EXIT
/* You selected 'Nowhere' */
end
end
else do
Tell("Enter output file (filename with complete path, or PRT: for printer,")
TellNN("or STDOUT for screen): ")
pull outname
if outname = "" then
outname = "STDOUT"
end
end
/* Anyone know a better way to translate numbers into Roman? */
GenerationS.1 = "I II III IV V VI VII VIII IX X XI XII XIII XIV XV XVI XVII XVIII XIX XX"
GenerationS.2 = "XXI XXII XXIII XXIV XXV XXVI XXVII XXVIII XXIX XXX XXXI XXXII XXXIII XXXIV XXXV XXXVI XXXVII XXXVIII IXL XL"
MaxChild = 26
/* Printer Codes, some of which are currently unused: */
ESC = '1B'x
prtinit = ESC||"#1"; /* ESC#1 initialize */
prtundon = ESC||"[4m"; /* ESC[4m underline on */
prtundoff = ESC||"[24m"; /* ESC[24m underline off */
prtdson = ESC||"[1m"; /* ESC[1m boldface on */
prtdsoff = ESC||"[22m"; /* ESC[22m boldface off */
prtnlqon = ESC||"[2"||'22'x||"z"; /* ESC[2"z NLQ on */
prtnlqoff = ESC||"[1"||'22'x||"z"; /* ESC[1"z NLQ off */
if ~usereq then
Tell("Printing...")
OpenPrinter()
childnums = irn; childgens = "1"
alcount = 0; chcount = 0
do while childnums ~= ""
irn = word(childnums, 1)
cgen = word(childgens, 1)
if cgen ~= currgen then do
alcount = 0
/* New generation: reset alfabet counter */
currgen = cgen
genchild = 0
end
childnums = delstr(childnums, 1, length(irn)+1)
childgens = delstr(childgens, 1, length(currgen)+1)
ccnt = 1
/* Sex to use with options 2 and 3 */
GETSEX irn
parsex = RESULT
g1 = GetPersonStr(irn)
mnum = 0
GETMARRIAGE irn mnum
fgrn = RESULT
EXISTFAMILY fgrn
ftrue = RESULT
do while ftrue = 'YES'
m1 = GetMarriageStr(fgrn)
ptn = GetPartnerIRN(fgrn, irn)
if ptn ~= 0 then do
if m1 ~= "" then m1 = m1||' '
m1 = m1||GetPersonStr(ptn)
end
if m1 ~= "" then m1 = ", m: "||m1
if ccnt = 1 then do
ggs = GetGenStr(currgen, 0)
if currgen > 1 then do
alcount = alcount + 1
/* TO DO: only if this person has any siblings who have children,
* or if there are other persons (with children) on this
* generation
*/
ggs = ggs||D2C(alcount+96)
end
ggs = left(ggs||". ", fill)
m1 = ggs||g1||m1||'.'
ccnt = 0
end
else
m1 = copies(' ',fill)||g1||m1||'.'
PrintLines(m1, fill)
if prtopt ~= 3 | parsex = malesex then
chcount = chcount + PrintChildren(fgrn, parsex)
PrintLF()
mnum = mnum + 1
GETMARRIAGE irn mnum
fgrn = RESULT
EXISTFAMILY fgrn
ftrue = RESULT
end
if mnum = 0 then do
m1 = GetGenStr(currgen,fill)||g1
PrintLines(m1, fill)
if currgen = 1 then
PrintLines("No marriages are recorded for this person.", 0)
PrintLF()
end
end
if currgen = 1 & chcount = 0 then do
if prtopt = 1 then
PrintLines("No descendants are recorded for person.")
else
PrintLines("No male descendants are recorded for person.")
end
writeln(prtdev, prtnlqoff);
close(prtdev)
if usereq then
rtezrequest('Output ready.','E_xit','PrintDescendant Message:','rt_pubscrname = '||PSCR)
else
Tell("Done.")
EXIT
ParseArguments:
if noirn = "NOIRN" then useirn = 0
else if noirn = "QUIET" || noirn = "NOREQ" then do
outval = noirn
noirn = ""
end
else do
outval = mgen
mgen = noirn
noirn = ""
end
if mgen = "QUIET" || mgen = "NOREQ" then do
outval = mgen
mgen = ""
end
MaxGens = 40; /* due to the Roman numbers, we can't handle more */
if mgen ~= "" then do
if DATATYPE(mgen, 'w') & mgen > 0 & mgen < MaxGens then
MaxGens = mgen
end
if outval = "QUIET" then do
usereq = 0
outp = 0
end
else if outval = "NOREQ" then
usereq = 0
if prtin = "" then do
prtopt = 0
if ~outp then TermError("Requires argument is missing.")
/* actually, with outp = 0, all it does is EXIT */
end
else do
prtopt = CheckAnswer(prtin)
/* Note that it was important to establish outp before calling these */
end
return 0
OpenPrinter:
/* Open the printer device and print out a nice header */
if outname = "STDOUT" then
prtdev = stdout
else do
prtdev = 'PRINTER'
if ~open(prtdev, outname, 'w') then
TermError("ERROR: Failed to open output file!")
end
writeln(prtdev, prtinit||prtnlqon)
if prtopt = 1 then
prtstr = "DESCENDANT CHART - ALL DESCENDANTS"
else if prtopt = 2 then
prtstr = "DESCENDANT CHART - ONLY MALE DESCENDANTS (TYPE I)"
else
prtstr = "DESCENDANT CHART - ONLY MALE DESCENDANTS (TYPE II)"
prtstr = prtundon||prtdson||prtstr||prtdsoff||prtundoff
writeln(prtdev, prtstr)
prtstr = prtdson||"Report printed on: "||date()||prtdsoff
writeln(prtdev, prtstr)
prtstr = copies('=', plwidth)
writeln(prtdev, prtstr)
return 0
PrintLines: PROCEDURE EXPOSE prtdev plwidth prtopt
parse arg ostr, fill
/* TO DO:
* if there are control strings within ostr (like prtdson or prtdsoff)
* don't include them in the length count
*/
do while ostr ~= ""
nnl = plwidth+1
if length(ostr) > plwidth then do
do until pc = ' ' | nnl = 1
pc = substr(ostr, nnl, 1)
nnl = nnl - 1
end
if nnl = 1 then do
prtstr = left(ostr, plwidth)
ostr = delstr(ostr, 1, nnl)
end
else do
prtstr = left(ostr, nnl)
ostr = delstr(ostr, 1, nnl+1)
end
end
else do
prtstr = ostr
ostr = ""
end
writeln(prtdev, prtstr)
if ostr ~= "" then
ostr = copies(' ',fill)||ostr
end
return 0
PrintLF:
writeln(prtdev, "")
return 1
PrintChildren:
parse arg ffnum, parsx
/* If we turn this into a PROCEDURE, we'll have to EXPOSE a lot!
* The disadvantage now is that we have to be extremely careful
* not to overwrite any global variables by accident!
*/
cidx = 0; cham = 0
GETCHILD ffnum cidx
chld = RESULT
EXISTPERSON chld
ctrue = RESULT
nextgen = currgen + 1
if nextgen > MaxGens then return cham
/* Maximum number of generations reached! */
do while ctrue = 'YES'
cidx = cidx + 1
if prtopt > 1 then do
GETSEX chld
csx = RESULT
end
if prtopt ~= 3 | csx = malesex then do
cham = cham + 1
m1 = copies(' ',8)||cham||". "||GetChildStr(chld)
if (prtopt = 1 | csx = malesex) & HasChild(chld) then do
childnums = childnums||chld||' '
childgens = childgens||nextgen||' '
genchild = genchild + 1
if genchild > MaxChild then return 1
/* Maximum number of children reached! */
/* TO DO: if genchild = 1 and the current person has no siblings,
* or none of his siblings have any children of their own,
* and if there are no other persons with children on this
* generation, then leave off the D2C part
*/
m1 = m1||", see "||GetGenStr(nextgen, 0)||D2C(genchild+96)
end
else
m1 = m1||GetDeathStr(chld)||GetMarriages(chld)
PrintLines(m1||'.', 11)
end
GETCHILD ffnum cidx
chld = RESULT
EXISTPERSON chld
ctrue = RESULT
end
return cham
GetGenStr: PROCEDURE EXPOSE GenerationS.
parse arg gnum, fill
if gnum <= 20 then
gstr = word(GenerationS.1, gnum)
else if gnum <= 40 then
gstr = word(GenerationS.2, gnum)
else
return ""
if fill > 0 then
gstr = left(gstr||". ",fill)
return gstr
GetPersonStr: PROCEDURE EXPOSE useirn
parse arg irn
if irn ~= 0 then do
nstr = GetNameStr(irn)
nstr = nstr||GetBirthStr(irn)
nstr = nstr||GetDeathStr(irn)
end
else
nstr = "UNKNOWN"
return nstr
GetChildStr: PROCEDURE EXPOSE useirn
parse arg irn
if irn ~= 0 then do
nstr = GetNameStr(irn)
nstr = nstr||GetBirthStr(irn)
end
else
nstr = "UNKNOWN"
return nstr
HasChild: PROCEDURE EXPOSE prtopt malesex
parse arg irn
mnum = 0
GETMARRIAGE irn mnum
marr = RESULT
EXISTFAMILY marr
mtrue = RESULT
do while mtrue = 'YES'
chnxt = 0
GETCHILD marr chnxt
ch = RESULT
EXISTPERSON ch
ct = RESULT
if prtopt < 3 then do
if ct = 'YES' then return 1
end
else do
/* For option 3: search for male children */
do while ct = 'YES'
GETSEX ch
csx = RESULT
if csx = malesex then return 1
chnxt = chnxt + 1
GETCHILD marr chnxt
ch = RESULT
EXISTPERSON ch
ct = RESULT
end
end
mnum = mnum + 1
GETMARRIAGE irn mnum
marr = RESULT
EXISTFAMILY marr
mtrue = RESULT
end
return 0
GetNameStr: PROCEDURE EXPOSE useirn
parse arg gnum
GETFIRSTNAME gnum
name = RESULT
if name ~= "" then name = name||" "
GETLASTNAME gnum
lname = RESULT
if lname = "" then lname = "UNKNOWN"
name = name||lname
if useirn then name = name||" ["gnum"]"
return name
GetBirthStr: PROCEDURE
parse arg gnum
GETBIRTHPLACE gnum
bstr = RESULT
GETBIRTHDATE gnum
bdat = RESULT
if bdat ~= "" & bstr ~= "" then bstr = bstr||" "
bstr = bstr||bdat
if bstr ~= "" then bstr = ", b: "||bstr
return bstr
GetDeathStr: PROCEDURE
parse arg gnum
GETDEATHPLACE gnum
dstr = RESULT
GETDEATHDATE gnum
ddat = RESULT
if ddat ~= "" & dstr ~= "" then dstr = dstr||" "
dstr = dstr||ddat
if dstr ~= "" then dstr = ", d: "||dstr
return dstr
GetMarriages: PROCEDURE EXPOSE useirn
parse arg irn
mstr = ""
GETMARRIAGE irn 0
mf = RESULT
EXISTFAMILY mf
if RESULT = 'YES' then do
mtrue = 1
GETMARRIAGE irn 1
m2 = RESULT
EXISTFAMILY m2
if RESULT = 'YES' then mset = 1
else mset = 0
end
else
mtrue = 0
mnum = 0
do while mtrue
m1 = GetMarriageStr(mf)
if m1 ~= "" then m1 = m1||' '
ptn = GetPartnerIRN(mf, irn)
m1 = m1||GetPersonStr(ptn)
if mset then mstr = ", m("||mnum||"): "||m1
else mstr = ", m: "||m1
mnum = mnum + 1
GETMARRIAGE irn mnum
mf = RESULT
EXISTFAMILY mf
if RESULT ~= 'YES' then mtrue = 0
end
return mstr
GetMarriageStr: PROCEDURE
parse arg mf
GETMARRYPLACE mf
mstr = RESULT
GETMARRYDATE mf
mdat = RESULT
if mdat ~= "" & mstr ~= "" then mstr = mstr||" "
mstr = mstr||mdat
return mstr
GetPartnerIRN: PROCEDURE
parse arg fnum, inum
GETPRINCIPAL fnum
prn = RESULT
GETSPOUSE fnum
sps = RESULT
if inum = prn then pnum = sps
else if inum = sps then pnum = prn
else pnum = 0
EXISTPERSON pnum
if RESULT ~= 'YES' then pnum = 0
return pnum
CheckAnswer: PROCEDURE EXPOSE outp prtdev
parse arg str
str = left(str, 1)
if ~DATATYPE(str, 'w') then
TermError("Arg(1): not a valid option number.")
if str < 1 | str > 3 then
TermError("Arg(1): not a valid option number.")
return str
CheckIRN: PROCEDURE EXPOSE outp prtdev
parse arg str
if ~DATATYPE(str, 'w') then
TermError("Arg(2): not a valid IRN.")
return str
Tell: PROCEDURE EXPOSE outp
parse arg str
if outp then
writeln(stdout, str)
return 0
TellNN: PROCEDURE EXPOSE outp
parse arg str
if outp then
writech(stdout, str)
return 0
TermError: PROCEDURE EXPOSE outp prtdev usereq PSCR
parse arg str
/* If you turned off stdout, no error messages will be shown! */
if usereq then
rtezrequest(str,'E_xit','PrintDescendant Message:','rt_pubscrname = '||PSCR)
else do
Tell(str || '0A'x)
end
close(prtdev)
EXIT
/* Let's make sure you get a nice message when you turn off the printer :-) */
IOERR:
bline = SIGL
say "I/O error #"||RC||" detected in line "||bline||":"
say sourceline(bline)
EXIT